home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / adatimer.zip / TIMEL5.ADA < prev    next >
Text File  |  1990-06-07  |  3KB  |  115 lines
  1. -- Listing 5.  A timer body for slow, non-critical
  2. -- applications.
  3.  
  4. with CALENDAR;
  5. package body POLLED_TIMER is
  6.  
  7.   CALENDAR_TICK : float := 65_536.0 / 1_193_180.0;
  8.     -- CALENDAR_TICK is system dependent.  The value
  9.     -- given is for the IBM PC AT.
  10.   CALENDAR_MAX  : float := 86_400.0;
  11.  
  12.   TIMER_PERIOD      : Duration;
  13.   TIMER_MODE        : Modes;
  14.   START_TIME, DONE  : CALENDAR.Time;
  15.   TIME_ALREADY_USED : Duration;
  16.   STOPPED           : boolean;
  17.  
  18.   procedure Set(PERIOD : Seconds;
  19.                 MODE   : Modes) is
  20.   begin
  21.     if Dimensionless(PERIOD)
  22.         > CALENDAR_MAX
  23.       then raise
  24.         INVALID_PERIOD;
  25.     end if;
  26.     if Dimensionless(PERIOD)
  27.         < CALENDAR_TICK
  28.       then raise
  29.         INVALID_PERIOD;
  30.     end if;
  31.     TIMER_PERIOD := Duration(
  32.       Dimensionless(PERIOD));
  33.     TIME_ALREADY_USED := 0.0;
  34.     STOPPED := TRUE;
  35.     TIMER_MODE   := MODE;
  36.   end Set;
  37.  
  38.   procedure Start is
  39.     use CALENDAR; -- for "+" and "-"
  40.   begin
  41.     START_TIME := CALENDAR.Clock;
  42.     DONE := START_TIME + TIMER_PERIOD
  43.       - TIME_ALREADY_USED;
  44.     STOPPED := FALSE;
  45.   end Start;
  46.  
  47.   procedure Restart is
  48.   begin
  49.     TIME_ALREADY_USED := 0.0;
  50.     Start;
  51.   end Restart;
  52.  
  53.   function Has_Expired return boolean is
  54.     use CALENDAR; -- for ">=" and "+"
  55.   begin
  56.     if Dimensionless(Time_Left) > 0.0 then
  57.       return FALSE;
  58.     else
  59.       case TIMER_MODE is
  60.         when SINGLE =>
  61.           Stop;
  62.           return TRUE;
  63.         when REPEATED =>
  64.           TIME_ALREADY_USED := CALENDAR.Clock - DONE;
  65.           Start;
  66.           return TRUE;
  67.       end case;
  68.     end if;
  69.   end Has_Expired;
  70.  
  71.   procedure Stop is
  72.     use CALENDAR; -- for "-"
  73.   begin
  74.     TIME_ALREADY_USED := CALENDAR.Clock
  75.       - START_TIME;
  76.     STOPPED := TRUE;
  77.   end Stop;
  78.  
  79.   function Time_Used return Seconds is
  80.     TIME : float;
  81.     use CALENDAR; -- for "-"
  82.   begin
  83.     if STOPPED then
  84.       TIME := float(TIME_ALREADY_USED);
  85.     else
  86.       TIME := float(TIMER_PERIOD
  87.          - (DONE - CALENDAR.Clock));
  88.     end if;
  89.     return Type_Convert(TIME);
  90.   end Time_Used;
  91.  
  92.   function Time_Left return Seconds is
  93.     DIFFERENCE : float;
  94.     use CALENDAR; -- for "-"
  95.   begin
  96.     if STOPPED then
  97.       DIFFERENCE := float(TIMER_PERIOD - TIME_ALREADY_USED);
  98.     else
  99.       DIFFERENCE := float(DONE - CALENDAR.Clock);
  100.     end if;
  101.     return Type_Convert(DIFFERENCE);
  102.   end Time_Left;
  103.  
  104.   function Max_Period return Seconds is
  105.   begin
  106.     return Type_Convert(CALENDAR_MAX);
  107.   end Max_Period;
  108.  
  109.   function Single_Tick return Seconds is
  110.   begin
  111.     return Type_Convert(CALENDAR_TICK);
  112.   end Single_Tick;
  113.  
  114. end POLLED_TIMER;
  115.